Proyecto - Contingencias de Vida II

Librerías e importaciones

source("cod/setup.R")
source("cod/load_database.R")
source("cod/prob_estim.R")

Factor de degradación para estados CAR

La metodología original empezaba a dar problemas con probabilidades negativas a partir de una edad aproximada de 95 años, por lo que se decidió implementar un factor de reducción desde los 90 años para primero, complementar la probabilidad creciente de muerte y además poder arreglar el problema de probabilidades negativas.

Empezar las tablas

source("cod/tablas.R")
Males <- tablas(1)
Females <- tablas(2)

Mejora de mortalidades en el tiempo y mejora de transiciones de empeoramiento

source("cod/degradar_mort.R")
a <- degradar_mort(20, 1)

Diseño del producto

Pago de primas: anual Esto se justifica con las probabilidades de transición de un año Temporalidad del seguro: vitalicio Es un seguro LTC, por lo que esperamos a que el asegurado tenga varios estados antes de morir. Si no fuera vitalicio, dejaríamos a medias a un asegurado. Temporalidad de pago de primas: hasta entrar en los estados severe/profound

Inflación: 3% Caso pesimista: 8% Caso optimista: -1%

Tasa de interés: 5% Caso pesimista: 3% Caso optimista: 6.5%

calculo_acumulado <- function(x, tables){
  # Por si acaso, termina en 000001 porque estamos multiplicando todas las transiciones
  t1 <- tables$Able %>% select(-x) 
  t2 <- tables$Mild %>% select(-x) 
  t3 <- tables$Moderate %>% select(-x)
  t4 <- tables$Severe %>% select(-x)
  t5 <- tables$Profound %>% select(-x)
  estados <- as.numeric(t1[1,])
  suma <- estados
  for(i in 2:(120-x)){
    matriz_t <- rbind(t1[i,], t2[i,], t3[i,], t4[i,], t5[i,], c(0,0,0,0,0,1)) 
    matriz_t <- as.matrix(matriz_t)
    estados <- estados %*% matriz_t
    suma <- suma + estados
  }
  return(suma)
}
calculo_acumulado(21, a)
##          Able     Mild Moderate   Severe Profound     Dead
## [1,] 47.37181 6.189344 3.146311 2.592936 3.691732 36.00786
d <- lapply(Males, function(x) as.data.frame(x[21:120,]))
calculo_acumulado(21, d)
##          Able    Mild Moderate  Severe Profound    Dead
## [1,] 42.42809 5.49957 2.619793 1.85696 2.063781 44.5318

Hay una clara diferencia entre mejorías de mortalidades

Cálculo de valores presentes

calculo_vp <- function(x, tables, interes, inflacion){
  # Por si acaso, termina en 000001 porque estamos multiplicando todas las transiciones
  v <- (1+inflacion)/(1+interes)
  t1 <- tables$Able %>% select(-x)
  t2 <- tables$Mild %>% select(-x) 
  t3 <- tables$Moderate %>% select(-x)
  t4 <- tables$Severe %>% select(-x)
  t5 <- tables$Profound %>% select(-x)
  estados <- as.numeric(t1[1,])
  suma <- estados
  seguro <- 0
  for(i in 2:(120-x)){
    matriz_t <- rbind(t1[i,], t2[i,], t3[i,], t4[i,], t5[i,], c(0,0,0,0,0,1)) 
    matriz_t <- as.matrix(matriz_t)
    temp <- estados %*% matriz_t
    
    # Personalizable según el tipo de desembolso/prima
    seguro <- seguro  + (temp[6]- estados[6])*v^i
    estados <- temp
    suma <- suma + estados*v^(i-1)
  }
  suma[6] <- seguro
  return(suma)
}
prueba <- calculo_vp(20, a, 0.07, 0.03)

# Seguro de vida normal, 100 millones
(prueba[6]*100e6 )/(12*prueba[1])
## [1] 40566.81
# Seguro de vida con anualidades en caso de Severe o Profound, pagando Mild y Moderate
(prueba[6]*100e6 + 12*(1e6*prueba[4] + 1.5e6*prueba[5])  )/(12*(prueba[1]+prueba[2]+prueba[3]))
## [1] 88955.21
# Seguro de vida con anualidades pagando 0.25e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.25e6*prueba[2] +
                         0.5e6*prueba[3] +
                         0.75e6*prueba[4] +
                         1e6*prueba[5]))/(12*prueba[1])
## [1] 111972.8
# Seguro de vida con anualidades pagando 0.5e6 en aumento de estado
(prueba[6]*100e6 + 12*(0.5e6*prueba[2] +
                         1e6*prueba[3] +
                         1.5e6*prueba[4] +
                         2e6*prueba[5]))/(12*prueba[1])
## [1] 183378.8